home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Apple II Magazines (PO)
/
Nibble Volume 11, No. 10 (1990-10)(MindCraft Publishing)(Side A)[a].zip
/
Nibble Volume 11, No. 10 (1990-10)(MindCraft Publishing)(Side A)[a].po
/
SCROLLER.bas
< prev
next >
Wrap
BASIC Source File
|
1996-12-24
|
9KB
|
188 lines
1 REM ***********************
2 REM * SCROLLER *
3 REM * BY ALAN A. HODSON *
4 REM * COPYRIGHT (C) 1990 *
5 REM * MINDCRAFT PUBL. CO. *
6 REM ***********************
10 PRINT CHR$(4)"PR#3": REM 80 COLUMN MODE
20 HOME : PRINT TAB( 30)"**********************": PRINT TAB( 31)"PROGRAM BY": PRINT TAB( 31)"BY ALAN A. HODSON": PRINT TAB( 31)"COPYRIGHT (C) 1990": PRINT TAB( 31)"MINDCRAFT PUBL. CORP.": PRINT TAB( 30)"**********************"
30 VTAB 23: PRINT TAB( 27)"INITIALIZING - PLEASE WAIT"
40 G$ = " ........": REM 18 BLANKS, 8.
50 DIM K$(65,15),F$(60),NN$(60),P$(12,12)
60 GOSUB 660: REM FIRST ARRAY
70 FOR I = 1 TO 59: FOR J = 1 TO 11: READ K$(I,J): NEXT : NEXT
80 FL = 1: GOSUB 450: REM TITLE
90 L1$ = "*******************************************************************************": REM 80 ASTERISKS
100 L2$ = "* ENTER UP TO SIXTY LINES *": REM 1*,28 LEADING BLANKS,25 TRAILING BLANKS,1*
110 L3$ = "* OF EIGHT CHARACTERS EACH *": REM 1*,27LB,25TB,1*
120 L4$ = "* HIT ANY KEY TO TERMINATE *": REM 1*,27LB,26TB,1*
130 PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT
140 POKE 34,17: REM CONTROL TOP PART OF SCREEN
150 VTAB 17: HTAB 1: PRINT L1$: PRINT L2$: PRINT L3$: PRINT L4$: PRINT L1$: PRINT : PRINT
160 VTAB 24: HTAB 1: INPUT "ENTER NUMBER OF LINES ";LL$: IF VAL(LL$) >60 THEN 190
170 IF VAL(LL$) = 0 THEN 130
180 LL = VAL(LL$): GOTO 200
190 PRINT CHR$(7);">>> MAXIMUM 60 PLEASE <<<": FOR ZZ = 1 TO 2500: NEXT : VTAB 18: GOSUB 650: GOTO 150
200 POKE 34,0: REM RESTORE FULL SCREEN
210 IF LL >9 THEN G$ = " " +G$: REM 1 BLANK
220 PRINT : FOR II = 1 TO LL
230 IF II = 10 THEN G$ = " " +G$: REM 1 BLANK
240 N$ = " ": GOSUB 650: REM 1 BLANK
250 VTAB 19: HTAB 1: PRINT : PRINT G$: PRINT "ENTER LINE# ";II;"/";LL;" ";: PRINT N$;: GET X$:X = ASC(X$)
260 SZ = LEN(N$): IF X = 13 THEN 350: REM SIZE & RETURN
270 IF X = 8 AND SZ >1 THEN N$ = LEFT$(N$, LEN(N$) -1): GOSUB 650: GOTO 250: REM BACKSPACE
280 IF X = 8 AND II = 1 THEN 250
290 IF X = 127 THEN N$ = LEFT$(N$, LEN(N$) -1): GOSUB 650: GOTO 250: REM LEFT ARROW
300 IF X = 44 THEN 250: REM COMMA CONTROL
310 IF X <32 THEN 250: REM CONTROL FOR LOW ASCII CHARACTERS
320 IF X = >123 THEN 250: REM CONTROL FOR {,|,},~ AND HIGHER
330 IF X >90 AND X <96 THEN 250: REM CONTROL FOR [,\,],^,_
340 N$ = N$ +X$: GOTO 250: REM BUILD N$
350 N$ = N$ +"-": REM ADD DUMMY END
360 L$ = N$: FOR J = 1 TO LEN(L$):CH$ = MID$ (L$,J,1): IF ASC(CH$) >96 AND ASC(CH$) <123 THEN N$ = LEFT$(N$,J -1) + CHR$( ASC( MID$ (N$,J,1)) -32) + MID$ (N$,J +1, LEN(L$)): GOTO 360
370 NEXT J: REM LOWER CASE TO UPPER
380 K$ = N$
390 N$ = RIGHT$(N$, LEN(K$) -1): IF LEN(N$) >1 THEN N$ = LEFT$(N$, LEN(K$) -2)
400 ZN = LEN(N$): IF ZN = 8 THEN 430
410 NZ = INT((8 -ZN)/2): FOR XS = 1 TO NZ:N$ = " " +N$: NEXT XS: REM PACK N$
420 IF LEN(N$) >9 THEN GOSUB 650: PRINT CHR$(7): PRINT " WORD TOO LONG- MAX 8 LETTERS... HIT <RETURN>": GET R$: GOTO 240
430 NN$(II) = N$:N$ = "": PRINT : NEXT
440 HOME : FOR P = 1 TO 7: PRINT : NEXT
450 IF FL = 1 THEN LL = 1:NN$(1) = "SCROLLER": VTAB 24
460 FOR QQ = 1 TO LL: REM MAIN LOOP
470 N$ = NN$(QQ)
480 LN = LEN(N$): FOR I = 1 TO LN
490 W = ASC( MID$ (N$,I,1)) -31
500 IF W = 1 THEN K$(W,1) = " "
510 IF K$(W,1) = MID$ (N$,I,1) THEN 530
520 K$(W,1) = "-"
530 FOR X = 1 TO 11:P$(X,I) = K$(W,X): NEXT X: NEXT I: REM TURN ARRAY AROUND
540 IF FL = 1 THEN HOME : VTAB 24
550 FOR Z = 2 TO 11: PRINT " ";: FOR ZZ = 1 TO LN: PRINT F$( VAL(P$(Z,ZZ)));: NEXT : PRINT : NEXT : REM 4 BLANKS - PRINT ARRAYS
560 IF FL = 1 THEN FL = 0: FOR TT = 1 TO 4: PRINT : NEXT : NEXT QQ: RETURN
570 PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : NEXT QQ: FOR T = 1 TO 2000: NEXT
580 ND = PEEK( -16384): IF ND >128 THEN 610
590 REM WAIT FOR A KEYPRESS AND THEN CLEAR KEYBOARD STROBE
600 POKE -16368,0: GOTO 440
610 POKE -16368,0: VTAB 24: HTAB 27: PRINT "QUIT SCROLLER NOW ? (Y/N) ";: GET ZZ$: IF ZZ$ = "Y" OR ZZ$ = "y" THEN HOME : GOTO 630
620 GOTO 440
630 VTAB 3: HTAB 27: PRINT " ANOTHER MESSAGE ? (Y/N) ";: GET ZZ$: IF ZZ$ = "Y" OR ZZ$ = "y" THEN PRINT : GOTO 90
640 HOME : END
650 : VTAB 15: CALL -958: RETURN : REM CLEAR SCREEN FROM CURSOR TO END
660 F$(0) = " ": REM 9 BLANKS (B), NO ASTERISKS (*)- TOTAL B'S + *'S MUST BE 9
670 F$(1) = " *** ": REM 3B,3*,3B
680 F$(2) = " ***** ": REM 2B,5*,2B
690 F$(3) = " ** ** ": REM 1B,2*,3B,2*,1B
700 F$(4) = " ******* ": REM 1B,7*,1B
710 F$(5) = " ** ** ": REM 1B,2*,2B,2*,2B
720 F$(6) = " ***** ": REM 1B,5*,3B
730 F$(7) = " ** ": REM 1B,2*,6B
740 F$(8) = " ****** ": REM 1B,6*,2B
750 F$(9) = " ** *** ": REM 1B,2*,2B,3*,1B
760 F$(10) = " ** ": REM 4B,2*,3B
770 F$(11) = " ** ** ": REM 1B,2*,1B,2*,3B
780 F$(12) = " **** * ": REM 1B,4*,2B,1*,1B
790 F$(13) = " ** *** ": REM 1B,2*,1B,3*,2B
800 F$(14) = " **** ": REM 1B,4*,4B
810 F$(15) = " *** *** ": REM 1B,3*,1B,3*,1B
820 F$(16) = " ** * ** ": REM 1B,2*,1B,1*,1B,2*,1B
830 F$(17) = " *** ** ": REM 1B,3*,2B,2*,1B
840 F$(18) = " **** ** ": REM 1B,4*,1B,2*,1B
850 F$(19) = " ** **** ": REM 1B,2*,1B,4*,1B
860 F$(20) = " * ": REM 7B,1*,1B
870 F$(21) = " ** ": REM 6B,2*,1B
880 F$(22) = " ** ** ": REM 2B,2*,1B,2*,2B
890 F$(23) = " * ": REM 4B,1*,4B
900 F$(24) = " ** ": REM 5B,2*,2B
910 F$(25) = " ** ": REM 2B,2*,5B
920 F$(26) = " * * ": REM 3B,1*,2B,1*,2B
930 F$(27) = " * * ": REM 3B,1*,1B,1*,3B
940 F$(28) = " ** * ": REM 2B,2*,3B,1*,1B
950 F$(29) = " ** * ": REM 2B,2*,2B,1*,2B
960 F$(30) = " * ": REM 5B,1*,3B
970 F$(31) = " * ": REM 3B,1*,5B
980 F$(32) = " * ** ": REM 2B,1*,2B,2*,2B
990 F$(33) = " * ** ": REM 1B,1*,3B,2*,2B
1000 F$(34) = " * * ": REM 1B,1*,2B,1*,4B
1010 F$(35) = " * * ": REM 4B,1*,2B,1*,1B
1020 F$(36) = " * * ": REM 2B,1*,3B,1*,2B
1030 F$(37) = " *** ": REM 2B,3*,4B
1040 F$(38) = " ** * * ": REM 1B,2*,2B,1*,1B,1*,1B
1050 F$(39) = " ** * ": REM 1B,2*,3B,1*,2B
1060 F$(40) = " **** ": REM 2B,4*,3B
1070 F$(41) = " *** ": REM 4B,3*,2B
1080 F$(42) = " ** ": REM 3B,2*,4B
1090 F$(43) = " * * * ": REM 1B,1*,2B,1*,2B,1*,1B
1100 F$(44) = " * * * ": REM 2B,1*,1B,1*,1B,1*,2B
1110 F$(45) = " ** * ": REM 1B,2*,4B,1*,1B
1120 F$(46) = " *** ": REM 5B,3*,1B
1130 F$(47) = " *** ": REM 1B,3*,5B
1140 F$(48) = " * ** ": REM 1B,1*,2B,2*,3B
1150 F$(49) = " * ": REM 1B,1*,7B
1160 F$(50) = " * * ": REM 1B,1*,5B,1*,1B
1170 F$(51) = " * *** * ": REM 1B,1*,1B,3*,1B,1*,1B
1180 F$(52) = " * * * * ": REM 1B,1*,1B,1*,1B,1*,1B,1*,1B
1190 F$(53) = " * ***** ": REM 1B,1*,1B,5*,1B
1200 RETURN : REM FIRST ENTRY BELOW IS SPACE BAR
1210 DATA ,0,0,0,0,0,0,0,0,0,0
1220 DATA !,1,1,1,1,1,1,23,0,23,0
1230 REM . APPEARS INSTEAD OF "
1240 DATA .,26,22,0,0,0,0,0,0,0,0
1250 DATA #,0,27,27,4,27,4,27,27,0,0
1260 DATA $,23,4,34,34,4,35,35,4,23,0
1270 DATA %,0,28,29,30,23,31,32,33,0,0
1280 DATA &,2,36,22,1,37,38,39,38,40,0
1290 DATA ',30,23,0,0,0,0,0,0,0,0
1300 DATA (,24,41,42,25,25,25,42,41,24,0
1310 DATA ),25,37,10,24,24,24,10,37,25,0
1320 DATA *,0,43,44,1,4,1,44,43,0,0
1330 DATA +,1,1,1,4,4,4,1,1,1,0
1340 REM . APPEARS INSTEAD OF ,
1350 DATA .,0,0,0,0,0,10,10,23,31,0
1360 DATA -,0,0,0,2,0,0,0,0,0,0
1370 DATA .,0,0,0,0,0,0,10,10,0,0
1380 DATA /,20,21,24,10,42,25,7,49,0,0
1390 DATA 0,2,4,3,3,3,3,3,4,2,0
1400 DATA 1,37,1,1,1,1,1,1,1,40,0
1410 DATA 2,4,4,3,46,41,1,37,4,4,0
1420 DATA 3,4,4,21,21,40,21,21,4,4,0
1430 DATA 4,3,3,3,4,4,21,21,21,21,0
1440 DATA 5,4,4,7,4,4,21,21,4,4,0
1450 DATA 6,4,4,7,7,4,4,3,4,4,0
1460 DATA 7,4,4,33,24,10,10,42,42,42,0
1470 DATA 8,2,4,3,4,1,4,3,4,2,0
1480 DATA 9,2,4,3,4,4,21,21,4,4,0
1490 REM . APPEARS INSTEAD OF :
1500 DATA .,0,23,23,0,0,23,23,0,0,0
1510 DATA ;,0,23,23,0,0,23,23,31,0,0
1520 DATA <,21,46,41,1,37,1,41,46,21,0
1530 DATA =,0,0,2,0,0,2,0,0,0,0
1540 DATA >,25,37,1,41,46,41,1,37,25,0
1550 DATA ?,4,4,3,46,41,1,42,0,42,0
1560 DATA @,4,50,51,52,52,52,53,49,4,0
1570 DATA A,1,2,3,3,4,4,3,3,3,0
1580 DATA B,4,3,3,5,6,5,3,3,4,0
1590 DATA C,8,8,7,7,7,7,7,4,4,0
1600 DATA D,6,8,9,3,3,3,9,8,6,0
1610 DATA E,4,4,7,7,6,7,7,4,4,0
1620 DATA F,4,4,7,7,6,7,7,7,7,0
1630 DATA G,4,4,7,7,7,9,3,4,4,0
1640 DATA H,3,3,3,4,4,3,3,3,3,0
1650 DATA I,4,4,1,1,1,1,1,4,4,0
1660 DATA J,4,4,10,10,10,11,11,6,6,0
1670 DATA K,3,9,13,6,14,6,13,9,3,0
1680 DATA L,7,7,7,7,7,7,7,4,4,0
1690 DATA M,3,15,4,16,16,3,3,3,3,0
1700 DATA N,3,17,18,4,19,9,3,3,3,0
1710 DATA O,4,4,3,3,3,3,3,4,4,0
1720 DATA P,4,4,3,4,4,7,7,7,7,0
1730 DATA Q,4,4,3,3,3,3,9,4,4,20
1740 DATA R,4,4,3,3,4,6,13,9,3,0
1750 DATA S,4,4,7,4,4,21,21,4,4,0
1760 DATA T,4,4,1,1,1,1,1,1,1,0
1770 DATA U,3,3,3,3,3,3,3,4,4,0
1780 DATA V,3,3,3,3,3,3,22,1,23,0
1790 DATA W,3,3,3,3,16,16,4,15,3,0
1800 DATA X,3,15,2,1,23,1,2,15,3,0
1810 DATA Y,3,15,22,1,1,1,1,1,1,0
1820 DATA Z,4,4,24,10,1,25,7,4,4,0